home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / surfsrc3.zip / GOURAUD.INC < prev    next >
Text File  |  1991-09-28  |  6KB  |  173 lines
  1. procedure GOURAUD;
  2. { Make a surface model drawing of the object with Gouraud interpolation
  3.   of surface shading }
  4.  
  5. var Node:                      word;          { node # }
  6.     Surf:                      word;          { surface # }
  7.     Shade:                     real;          { shade of surface }
  8.     Shade2:                    real;          { shade of 2nd side of surface }
  9.     Vert:                      integer;       { vertex # }
  10.     Interp:                    boolean;       { flag interpolated shading }
  11.     User_abort:                boolean;       { did the user abort? }
  12.     ch:                        char;
  13. {$ifndef BIGMEM}
  14.     Shades: nodearray;
  15.       { shade at each node }
  16.     Surfmin, Surfmax: surfaces;
  17.       { surface minimum & maximum (Ztran) }
  18.     Nshades: array[1..MAXNODES] of integer;
  19.       { # shades to average per node }
  20.     Sshade: surfaces;
  21.       { shade at each surface }
  22. {$endif}
  23. label ABORTTEXT,                              { text-mode abort }
  24.       ABORTGRPH;                              { graphics-mode abort }
  25.  
  26. begin
  27. {$ifdef BIGMEM}
  28. with ptrh^ do with ptri^ do with ptrj^ do
  29. with ptra^ do with ptrb^ do with ptrc^ do
  30. with ptrd^ do with ptre^ do with ptrf^ do
  31. with ptrh^ do with ptri^ do with ptrj^ do
  32. with ptrk^ do with ptrl^ do with ptrm^ do with ptrn^ do
  33. begin
  34. {$endif}
  35.  
  36.   perf_start;
  37.   User_abort := TRUE;
  38.   if (checkey) then goto ABORTTEXT;
  39. {$ifndef NOSHADOW}
  40.   if (Shadowing) then begin
  41.     shadows (Shades);
  42.     for Node := 1 to Nnodes do
  43.       Nshades[Node] := 0;
  44.   end else
  45. {$else}
  46.   if (Shadowing) then
  47.     writeln ('Error: Shadows not implemented in this version')
  48.   else
  49. {$endif}
  50.     for Node := 1 to Nnodes do begin
  51.       Shades[Node] := 0.0;
  52.       Nshades[Node] := 0;
  53.     end;
  54.  
  55.   if (Viewchanged) or (Shadowing) then begin
  56.     if (checkey) then goto ABORTTEXT;
  57.     menumsg ('Transforming to 2-D...');
  58. { Transform from 3-D to 2-D coordinates }
  59.     setorigin;
  60.     for Node := 1 to Nnodes do
  61.       perspect (Xworld[Node], Yworld[Node], Zworld[Node],
  62.                 Xtran[Node],  Ytran[Node],  Ztran[Node]);
  63.  
  64. { Set plotting limits and normalize transformed coords to screen coords }
  65.     perspect (Xfocal, Yfocal, Zfocal, Xfotran, Yfotran, Zfotran);
  66.     if (not setnormal (Xfotran, Yfotran, XYmax)) then begin
  67.       menumsg ('Warning: Focal point outside data limits.');
  68.       writeln;
  69.       write   ('  Press any key ...');
  70.       ch := readkey;
  71.     { Erase the previous message }
  72.       menumsg ('');
  73.       writeln;
  74.       write ('                          ');
  75.     end;
  76.  
  77.     if (checkey) then goto ABORTTEXT;
  78. { Normalize all the nodes }
  79.     for Node := 1 to Nnodes do
  80.       normalize (Xtran[Node], Ytran[Node], Xfotran, Yfotran, XYmax);
  81.     { Initialize all nodal shades to zero }
  82.  
  83.     if (checkey) then goto ABORTTEXT;
  84.     menumsg ('Sorting surfaces...');
  85.     minmax (Surfmin, Surfmax, Nsurf);
  86.     shelsurf (Surfmin, Surfmax, Nsurf);
  87.     Viewchanged := FALSE;
  88.   end; { if Viewchanged }
  89.  
  90.   setshade;                            { Setup for shading calculations }
  91.  
  92. { Compute the cumulative shading at every node (sum the shades due to
  93.   all surrounding surfaces) }
  94.   if (checkey) then goto ABORTTEXT;
  95.   menumsg ('Computing shades...');
  96.   for Surf := 1 to Nsurf do begin
  97.     if (Nsides = 2) then begin
  98.       { Use only the side of the surface with the brightest shade }
  99.       Shade := Shading (Surf, 1);
  100.       Shade2 := Shading (Surf, 2);
  101.       if (Shade2 > Shade) then
  102.         Shade := Shade2;
  103.     end else
  104.       Shade := Shading (Surf, 1);
  105.     { Surface shade }
  106.     Sshade[Surf] := Shade;
  107.     { Nodal shade }
  108.     for Vert := 1 to Nvert[Surf] do begin
  109.       Node := konnec (Surf, Vert);
  110.       if (Shade >= 0.0) and (Shades[Node] >= 0.0) then begin
  111.         Shades[Node] := Shades[Node] + Shade;
  112.         Nshades[Node] := Nshades[Node] + 1;
  113.       end;
  114.     end; { for Vert }
  115.   end; { for Surf }
  116.  
  117.   if (checkey) then goto ABORTTEXT;
  118. { Now average out the nodal shading }
  119.   for Node := 1 to Nnodes do
  120.     if (Nshades[Node] > 0) then
  121.       Shades[Node] := Shades[Node] / Nshades[Node];
  122.  
  123. {$ifdef USE_IFF}
  124.   menumsg ('Plotting...');
  125. {$endif}
  126.  
  127. { Now plot all the surfaces, with Gouraud shading }
  128.   setgmode (Nmatl);
  129.   for Surf := 1 to Nsurf do begin
  130.     if (Sshade[Surf] >= 0.0) then begin
  131.       Interp := TRUE;
  132.       { If any nodal shade varies from the average (surface) shade by more
  133.         than Epsilon, then don't use interpolated shading (unless the node
  134.         is in a shadow, in which case you should interpolate anyway) }
  135.       for Vert := 1 to Nvert[Surf] do begin
  136.         Node := konnec (Surf, Vert);
  137.         if (abs(Shades[Node] - Sshade[Surf]) > Epsilon) and
  138.            (Shades[Node] >= 0.0) then
  139.           Interp := FALSE;
  140.       end;
  141.       if (Interp) then
  142.         intrfill (Surf, Matl[Surf], Shades)
  143.       else
  144.         fillsurf (Surf, Matl[Surf], Sshade[Surf]);
  145.       { Show border of surface, if requested }
  146.       if (ShowAllBorders > 0) then
  147.         border (Surf, Matl[Surf]);
  148.     end; { if Sshade }
  149.     if (grafstat) then goto ABORTGRPH;
  150.   end; { for Surf }
  151.   drawaxes (Xfotran, Yfotran, XYmax);
  152.  
  153.   perf_stop (5);
  154.  
  155. {$ifdef USE_IFF}
  156.   menumsg ('Saving IFF...');
  157.   saveiff (Filemask + '.IFF', VGApal);
  158. {$else}
  159.   { Wait for user keypress to continue }
  160.   continue;
  161. {$endif}
  162.   User_abort := FALSE;
  163.  
  164.   ABORTGRPH:
  165.   exgraphic;
  166.   ABORTTEXT:
  167.   if (User_abort) then
  168.     perf_stop (0);
  169. {$ifdef BIGMEM}
  170. end; {with}
  171. {$endif}
  172. end; {procedure GOURAUD }
  173.